home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / str.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  9.5 KB  |  363 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: str.c,v 1.12 94/11/29 06:43:07 wlott Exp $
  27. *
  28. * This file implements strings.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "gc.h"
  36. #include "coll.h"
  37. #include "class.h"
  38. #include "char.h"
  39. #include "module.h"
  40. #include "num.h"
  41. #include "bool.h"
  42. #include "obj.h"
  43. #include "str.h"
  44. #include "error.h"
  45. #include "type.h"
  46. #include "print.h"
  47. #include "list.h"
  48. #include "def.h"
  49. #include "sym.h"
  50.  
  51. obj_t obj_ByteStringClass = 0;
  52. obj_t obj_UnicodeStringClass = 0;
  53.  
  54. /*
  55.    There is no corresponding make_unicode_string because it is worthless
  56.    for interfacing with C code.
  57. */
  58. obj_t make_byte_string(char *chars)
  59. {
  60.     int len = strlen(chars);
  61.     obj_t res = alloc(obj_ByteStringClass, sizeof(struct string) 
  62.               + len + 1 - sizeof(((struct string *)res)->chars));
  63.  
  64.     obj_ptr(struct string *, res)->len = len;
  65.     strcpy((char *)obj_ptr(struct string *, res)->chars, chars);
  66.  
  67.     return res;
  68. }
  69.  
  70.  
  71. obj_t alloc_byte_string(int len)
  72. {
  73.     obj_t res = alloc(obj_ByteStringClass, sizeof(struct string)
  74.               + len + 1 - sizeof(((struct string *)res)->chars));
  75.  
  76.     obj_ptr(struct string *, res)->len = len;
  77.     obj_ptr(struct string *, res)->chars[len] = '\0';
  78.  
  79.     return res;
  80. }
  81.  
  82. obj_t alloc_unicode_string(int len)
  83. {
  84.     obj_t res = alloc(obj_UnicodeStringClass, 
  85.               sizeof(struct string) 
  86.               + 2*(len+1) - sizeof(((struct string *)res)->chars));
  87.  
  88.     obj_ptr(struct string *, res)->len = len;
  89.     obj_ptr(struct string *, res)->chars[2*len] = '\0';
  90.     obj_ptr(struct string *, res)->chars[2*len + 1] = '\0';
  91.  
  92.     return res;
  93. }
  94.  
  95. /* Dylan routines. */
  96.  
  97. static obj_t dylan_byte_str_element(obj_t str, obj_t index, obj_t def)
  98. {
  99.     int i = fixnum_value(index);
  100.  
  101.     if (0 <= i && i < obj_ptr(struct string *, str)->len)
  102.     return int_char(string_chars(str)[i]);
  103.     else if (def != obj_Unbound)
  104.     return def;
  105.     else {
  106.     error("No element %= in %=", index, str);
  107.     return NULL;
  108.     }
  109. }
  110.  
  111. static obj_t dylan_unicode_str_element(obj_t str, obj_t index, obj_t def)
  112. {
  113.     int i = fixnum_value(index);
  114.  
  115.     if (0 <= i && i < obj_ptr(struct string *, str)->len)
  116.     return int_char(get_unichar(str, i));
  117.     else if (def != obj_Unbound)
  118.     return def;
  119.     else {
  120.     error("No element %= in %=", index, str);
  121.     return NULL;
  122.     }
  123. }
  124.  
  125. static obj_t dylan_byte_str_element_setter(obj_t value, obj_t str, obj_t index)
  126. {
  127.     int i = fixnum_value(index);
  128.  
  129.     if (0 <= i && i < obj_ptr(struct string *, str)->len)
  130.     string_chars(str)[i] = char_int(value);
  131.     else
  132.     error("No element %= in %=", index, str);
  133.  
  134.     return value;
  135. }
  136.  
  137. static obj_t dylan_unicode_str_element_setter(obj_t value,
  138.                           obj_t str, obj_t index)
  139. {
  140.     int i = fixnum_value(index);
  141.  
  142.     if (0 <= i && i < obj_ptr(struct string *, str)->len) {
  143.     string_chars(str)[2*i]
  144.         = obj_ptr(struct character *, value)->high_byte;
  145.     string_chars(str)[2*i + 1] 
  146.         = obj_ptr(struct character *, value)->low_byte;
  147.     }
  148.     else
  149.     error("No element %= in %=", index, str);
  150.  
  151.     return value;
  152. }
  153.  
  154. static obj_t dylan_str_size(obj_t str)
  155. {
  156.     return make_fixnum(obj_ptr(struct string *, str)->len);
  157. }
  158.  
  159. static obj_t dylan_byte_str_make(obj_t class, obj_t size, obj_t fill)
  160. {
  161.     obj_t res;
  162.     int len;
  163.     unsigned char *ptr;
  164.     int fill_char;
  165.  
  166.     len = fixnum_value(check_type(size, obj_FixnumClass));
  167.  
  168.     if (len < 0)
  169.     error("Bogus size: for make %=: %=", class, size);
  170.  
  171.     fill_char = char_int(check_type(fill, obj_ByteCharacterClass));
  172.  
  173.     res = alloc_byte_string(len);
  174.  
  175.     ptr = string_chars(res);
  176.     while (len-- > 0)
  177.     *ptr++ = fill_char;
  178.     *ptr = '\0';
  179.  
  180.     return res;
  181. }
  182.  
  183. static obj_t dylan_unicode_str_make(obj_t class, obj_t size, obj_t fill)
  184. {
  185.     obj_t res;
  186.     int len;
  187.     int i;
  188.     int fill_char;
  189.  
  190.     len = fixnum_value(check_type(size, obj_FixnumClass));
  191.  
  192.     if (len < 0)
  193.     error("Bogus size: for make %=: %=", class, size);
  194.  
  195.     fill_char = char_int(check_type(fill, obj_CharacterClass));
  196.  
  197.     res = alloc_unicode_string(len);
  198.  
  199.     for (i=0; i<len; i++) {
  200.     string_chars(res)[2*i] = (fill_char >> 8);
  201.     string_chars(res)[2*i + 1] = (fill_char & 255);
  202.     }
  203.     string_chars(res)[2*len] = (fill_char >> 8);
  204.     string_chars(res)[2*len + 1] = (fill_char & 255);
  205.  
  206.     return res;
  207. }
  208.  
  209.  
  210. /* Printer support. */
  211.  
  212. static void print_byte_string(obj_t str)
  213. {
  214.     int len = obj_ptr(struct string *, str)->len;
  215.     unsigned char *ptr = string_chars(str);
  216.  
  217.     putchar('"');
  218.     while (len-- > 0) {
  219.         if (*ptr == '\n')
  220.         printf("\\n");
  221.     else if (*ptr < ' ' || *ptr > '~')
  222.         printf("\\%03o", *ptr);
  223.     else if (*ptr == '"')
  224.         printf("\\\"");
  225.     else
  226.         putchar(*ptr);
  227.     ptr++;
  228.     }
  229.     putchar('"');
  230. }
  231.  
  232. static void print_unicode_string(obj_t str)
  233. {
  234.     int len = obj_ptr(struct string *, str)->len;
  235.     int i = 0;
  236.     int c;
  237.  
  238.     putchar('"');
  239.     for (i=0; i<len; i++) {
  240.     c = get_unichar(str, i);
  241.     if (c == '\n')
  242.         printf("\\n");
  243.     else if (c > 255)
  244.         printf("\\{#x%x}", c);
  245.     else if (c < ' ' || c > '~')
  246.         printf("\\%03o", c);
  247.     else if (c == '"')
  248.         printf("\\\"");
  249.     else
  250.         putchar(c);
  251.     }
  252.     putchar('"');
  253. }
  254.  
  255.  
  256. /* GC stuff. */
  257.  
  258. static int scav_byte_string(struct object *ptr)
  259. {
  260.     struct string *str = (struct string *)ptr;
  261.  
  262.     return sizeof(struct string) + str->len + 1 - sizeof(str->chars);
  263. }
  264.  
  265. static int scav_unicode_string(struct object *ptr)
  266. {
  267.     struct string *str = (struct string *)ptr;
  268.  
  269.     return sizeof(struct string)
  270.     + 2*(str->len + 1) - sizeof(str->chars);
  271. }
  272.  
  273. static obj_t trans_byte_string(obj_t string)
  274. {
  275.     return transport(string,
  276.              sizeof(struct string)
  277.              + obj_ptr(struct string *, string)->len + 1
  278.              - sizeof(((struct string *)string)->chars));
  279. }
  280.  
  281. static obj_t trans_unicode_string(obj_t string)
  282. {
  283.     return transport(string,
  284.              sizeof(struct string) 
  285.              + 2 * (obj_ptr(struct string *, string)->len + 1)
  286.              - sizeof(((struct string *)string)->chars));
  287. }
  288.  
  289. void scavenge_str_roots(void)
  290. {
  291.     scavenge(&obj_ByteStringClass);
  292.     scavenge(&obj_UnicodeStringClass);
  293. }
  294.  
  295.  
  296. /* Init stuff. */
  297.  
  298. void make_str_classes(void)
  299. {
  300.     obj_ByteStringClass = make_builtin_class(scav_byte_string,
  301.                          trans_byte_string);
  302.     obj_UnicodeStringClass = make_builtin_class(scav_unicode_string, 
  303.                         trans_unicode_string);
  304. }
  305.  
  306. void init_str_classes(void)
  307. {
  308.     init_builtin_class(obj_ByteStringClass, "<byte-string>",
  309.                obj_VectorClass, obj_StringClass, NULL);
  310.     init_builtin_class(obj_UnicodeStringClass, "<unicode-string>",
  311.                obj_VectorClass, obj_StringClass, NULL);
  312.     def_printer(obj_ByteStringClass, print_byte_string);
  313.     def_printer(obj_UnicodeStringClass, print_unicode_string);
  314. }
  315.  
  316. void init_str_functions(void)
  317. {
  318.     define_method("element",
  319.             list2(obj_ByteStringClass, obj_FixnumClass),
  320.             FALSE, list1(pair(symbol("default"), obj_Unbound)), FALSE,
  321.             obj_ByteCharacterClass, dylan_byte_str_element);
  322.     define_method("element",
  323.             list2(obj_UnicodeStringClass, obj_FixnumClass),
  324.             FALSE, list1(pair(symbol("default"), obj_Unbound)), FALSE,
  325.             obj_CharacterClass, dylan_unicode_str_element);
  326.     define_method("element-setter",
  327.           list3(obj_ByteCharacterClass,
  328.             obj_ByteStringClass,
  329.             obj_FixnumClass),
  330.           FALSE, obj_False, FALSE,
  331.           obj_ObjectClass, dylan_byte_str_element_setter);
  332.     define_method("element-setter",
  333.           list3(obj_CharacterClass,
  334.             obj_UnicodeStringClass,
  335.             obj_FixnumClass),
  336.           FALSE, obj_False, FALSE,
  337.           obj_ObjectClass, dylan_unicode_str_element_setter);
  338.  
  339.     /* size is the same for both <byte-string> and <unicode-string>, 
  340.        but not for the general user defined instance of <string>.
  341.     */
  342.     define_method("size", list1(obj_ByteStringClass),
  343.           FALSE, obj_False, FALSE, obj_FixnumClass, dylan_str_size);
  344.     define_method("size", list1(obj_UnicodeStringClass),
  345.           FALSE, obj_False, FALSE, obj_FixnumClass, dylan_str_size);
  346.  
  347.     /* make(<string>) returns a <byte-string>, even if fill happens to 
  348.        be a unicode character.
  349.     */
  350.     define_method("make", list1(singleton(obj_StringClass)), FALSE,
  351.           list2(pair(symbol("size"), make_fixnum(0)),
  352.             pair(symbol("fill"), int_char('\0'))),
  353.           FALSE, obj_ByteStringClass, dylan_byte_str_make);
  354.     define_method("make", list1(singleton(obj_ByteStringClass)), FALSE,
  355.           list2(pair(symbol("size"), make_fixnum(0)),
  356.             pair(symbol("fill"), int_char('\0'))),
  357.           FALSE, obj_ByteStringClass, dylan_byte_str_make);
  358.     define_method("make", list1(singleton(obj_UnicodeStringClass)), FALSE,
  359.           list2(pair(symbol("size"), make_fixnum(0)),
  360.             pair(symbol("fill"), int_char('\0'))),
  361.           FALSE, obj_UnicodeStringClass, dylan_unicode_str_make);
  362. }
  363.